home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 12 / Amiga Plus Sonderheft Amiga 12.iso / pd / spiele / klondike_adptools / install / datas / english.lha / 3-MakeGlobalPalette.adpro < prev    next >
Text File  |  1997-08-22  |  15KB  |  690 lines
  1. /*
  2. ** MakeGlobalPalette.adpro :
  3. **
  4. **  This ARexx script for ADPro v2.5 or higher,
  5. **  load some previously scaled pictures (IFF ILBM 24Bits, 86x128) selected by user, compose and render them
  6. **  into a big backdrop picture, and finally save the generated palette.
  7. **
  8. **  Klondike & Reko Tools © Copyright Reko Productions - All Rights Reserved.
  9. **
  10. ** $VER: MakeGlobalPalette/English v2.0 (16.06.97) Copyright © 1995-97 Lejardinier Olivier - All Rights Reserverd
  11. **
  12. */
  13.  
  14. /*
  15. ** ARexx Initialisations
  16. */
  17.  
  18.  ADDRESS "ADPro"
  19.  OPTIONS RESULTS
  20.  ReturnCode = 0
  21.  
  22. /*
  23. ** Parse Arguments.
  24. */
  25.  
  26.  PARSE ARG Mode
  27.  
  28. /*
  29. ** Contants Initializations
  30. */
  31.  
  32.  NL = '0A'X
  33.  DNL = NL || NL
  34.  FALSE = 0
  35.  TRUE = 1
  36.  
  37. /*
  38. ** Strings initializations.
  39. */
  40.  
  41.  TITLE_Error = "Error :"
  42.  TITLE_Request = "Request :"
  43.  TITLE_Confirm = "Confirm :"
  44.  
  45.  TITLE_SelectScaledPic = "Select 1 scaled picture :"
  46.  TITLE_SelectPaletteFile = "Global palette destination :"
  47.  
  48.  MSG_Abort = "Abort ?"
  49.  MSG_ErrorCode = "Error code ="
  50.  MSG_ADProResult = "ADPro result ="
  51.  
  52.  MSG_UnableToSaveADProPrefs = "Unable to load ADPro prefs."
  53.  MSG_UnableToRestoreADProPrefs = "Unable to restore ADPro prefs."
  54.  
  55.  MSG_YouMustSelectScaledPic = "You MUST select 1 scaled picture !"
  56.  MSG_CheckingScaledPic = "Checking scaled picture"
  57.  MSG_MissingScaledPic = "Scaled picture missing :"
  58.  
  59.  MSG_WhatBckgrndColor = "Do you to use DEFAULT or CUSTOM background color ?"
  60.  MSG_SelectREDComponent = "Enter RED component :"
  61.  MSG_SelectGREENComponent = "Enter GREEN component :"
  62.  MSG_SelectBLUEComponent = "Enter BLUE component :"
  63.  
  64.  MSG_NotEnoughtMemoryToComputePalette = "No enought memory to compute palette"
  65.  MSG_UnableToCreateBackdrop = "Unable to create backdrop picture"
  66.  
  67.  MSG_LoadingScaledPic = "Loading scaled picture"
  68.  MSG_UnableToLoadScaledPic = "Unable to load scaled picture :"
  69.  MSG_NoScaledPicLoaded = "None scaled picture loaded
  70.  
  71.  MSG_ComputingPalette = "Computing palette"
  72.  MSG_UnableToComputePalette = "Unable to compute palette"
  73.  MSG_SavingPalette = "Saving palette"
  74.  MSG_UnableToSavePalette = "Unable to save palette :"
  75.  
  76.  GAD_Abort = "Abort"
  77.  GAD_ContinueAbort = "Continue|Abort"
  78.  GAD_SelectAbort = "Select|Abort"
  79.  GAD_DefaultCustomAbort = "Default|Custom|Abort"
  80.  GAD_Quit = "Quit"
  81.  GAD_OkSelectAbort = "Ok|Select|Abort"
  82.  GAD_RetryAbort = "Retry|Abort"
  83.  GAD_RetrySkipAbort = "Retry|Skip|Abort"
  84.  
  85. /*
  86. ** Save the current ADPro environment.
  87. */
  88.  
  89.  TempDefaults = "T:TempADProDefaults"
  90.  
  91.  SAVE_DEFAULTS '"'TempDefaults'"'
  92.  IF ( RC ~= 0 ) THEN
  93.   DO
  94.    Text = MSG_UnableToSaveADProPrefs || MSG_ADProError ADPRO_RESULT
  95.    OKAY1 '"'Text'"'
  96.   END
  97.  
  98. /*
  99. ** Initializations of new ADPro environment.
  100. */
  101.  
  102.  CLOSE_RENDER_SCREEN
  103.  CLEAR_RENDERED
  104.  CLEAR_RAW
  105.  PSTATUS "UNLOCKED"
  106.  DISPLAYMESSAGE '""'
  107.  ADPRO_TO_FRONT
  108.  
  109. /*
  110. ** Get some previously scaled pictures files.
  111. */
  112.  
  113.  ScaledPicsDir = GetPref( "KADPT.ScaledPicsDir" )
  114.  
  115.  IF ( ( ScaledPicsDir ~= "" ) & ( Mode = "AUTO" ) ) THEN
  116.   DO
  117.    ScaledPicsBaseName = GetPref( "KADPT.ScaledPicsBaseName" )
  118.    ScaledPicPath = AddPart( ScaledPicsDir, AddExt( ScaledPicsBaseName, "001" ) )
  119.    RetVal = CheckScaledPics( ScaledPicPath )
  120.    IF ( WORD( RetVal, 1 ) ~= 52 ) THEN
  121.     DO
  122.      ReturnCode = 10
  123.      CALL Quit
  124.     END
  125.   END
  126.  ELSE
  127.  DO
  128.  
  129.  Continue = FALSE
  130.  DO UNTIL ( Continue = TRUE )
  131.   
  132.   IF ( ScaledPicsDir ~= "" ) THEN
  133.    GETFILE '"'TITLE_SelectScaledPic'"' '"'ParseDir( ScaledPicsDir )'"' '""'
  134.   ELSE
  135.    GETFILE '"'TITLE_SelectScaledPic'"'
  136.  
  137.   IF ( RC ~= 0 ) THEN
  138.    DO
  139.     OKAYN '"'TITLE_Error'"' '"'MSG_YouMustSelectScaledPic'"' '"'GAD_SelectAbort'"'
  140.     IF ( RC = 0 ) THEN
  141.      CALL ConfirmAbort
  142.    END
  143.   ELSE
  144.    DO
  145.     ScaledPicPath = ADPRO_RESULT
  146.     
  147.     RetVal = CheckScaledPics( ScaledPicPath )
  148.     
  149.     IF ( WORD( RetVal, 1 ) = 52 ) THEN
  150.      DO
  151.       SetPref( "KADPT.ScaledPicsDir", WORD( RetVal, 2 ) )
  152.       Continue = TRUE
  153.      END
  154.    END
  155.  END
  156.  
  157.  END
  158.  
  159.  ScaledPicsDir = WORD( RetVal, 2 )
  160.  ScaledPicsBaseName = WORD( RetVal, 3 )
  161.  NbScaledPics = WORD( RetVal, 1 )
  162.  
  163. /*
  164. ** Request background color.
  165. */
  166.  
  167.  OKAYN '"'TITLE_Request'"' '"'MSG_WhatBckgrndColor'"' '"'GAD_DefaultCustomAbort'"'
  168.  IF ( RC = 0 ) THEN
  169.   CALL ConfirmAbort
  170.  ELSE
  171.   IF ( RC = 1 ) THEN
  172.    DO
  173.     UserRed = 56
  174.     UserGreen = 101
  175.     UserBlue = 121
  176.    END
  177.   ELSE
  178.    DO
  179.     UserRed = GetPref( "KADPT.UserRed" )
  180.     IF ( UserRed = "" ) THEN
  181.      UserRed = 56
  182.  
  183.     Continue = FALSE
  184.     DO UNTIL ( Continue = TRUE )
  185.      GETNUMBER '"'MSG_SelectREDComponent'"' ParseString( UserRed ) 0 255
  186.      IF ( RC ~= 0 ) THEN
  187.       CALL ConfirmAbort
  188.      ELSE
  189.       DO
  190.        UserRed = ADPRO_RESULT
  191.        SetPref( "KADPT.UserRed", UserRed )
  192.        Continue = TRUE
  193.       END
  194.     END
  195.  
  196.     UserGreen = GetPref( "KADPT.UserGreen" )
  197.     IF ( UserGreen = "" ) THEN
  198.      UserGreen = 101
  199.  
  200.     Continue = FALSE
  201.     DO UNTIL ( Continue = TRUE )
  202.      GETNUMBER '"'MSG_SelectGREENComponent'"' ParseString( UserGreen ) 0 255
  203.      IF ( RC ~= 0 ) THEN
  204.       CALL ConfirmAbort
  205.      ELSE
  206.       DO
  207.        UserGreen = ADPRO_RESULT
  208.        SetPref( "KADPT.UserGreen", UserGreen )
  209.        Continue = TRUE
  210.       END
  211.     END
  212.   
  213.     UserBlue = GetPref( "KADPT.UserBlue" )
  214.     IF ( UserBlue = "" ) THEN
  215.      UserBlue = 121
  216.  
  217.     Continue = FALSE
  218.     DO UNTIL ( Continue = TRUE )
  219.      GETNUMBER '"'MSG_SelectBLUEComponent'"' ParseString( UserBlue ) 0 255
  220.      IF ( RC ~= 0 ) THEN
  221.       CALL ConfirmAbort
  222.      ELSE
  223.       DO
  224.        UserBlue = ADPRO_RESULT
  225.        SetPref( "KADPT.UserBlue", UserBlue )
  226.        Continue = TRUE
  227.       END
  228.     END
  229.    END
  230.  
  231. /*
  232. ** Create a backdrop picture.
  233. */
  234.  
  235.  NbRows = ( NbScaledPics + 3 ) % 4
  236.  
  237.  LOAD_TYPE "REPLACE"
  238.  
  239.  Continue = FALSE
  240.  DO UNTIL ( ( Continue = TRUE ) | ( NbRows = 0 ) )
  241.   LOADER "BACKDROP" "XXX" "WIDTH" 4*88 "HEIGHT" NbRows*130 "COLOR" UserRed UserGreen UserBlue
  242.   IF ( RC ~= 0 ) THEN
  243.    DO
  244.     IF ( ADPRO_RESULT = "Aborted" ) THEN
  245.      CALL ConfirmAbort
  246.     ELSE
  247.      NbRows = NbRows - 1
  248.    END
  249.   ELSE
  250.    Continue = TRUE
  251.  END
  252.  
  253.  IF ( NbRows = 0 ) THEN
  254.   DO
  255.    OKAYN '"'TITLE_Error'"' '"'MSG_NotEnoughtMemoryToComputePalette'"' '"'GAD_Quit'"'
  256.    CALL Quit
  257.   END
  258.  
  259.  Continue = FALSE
  260.  DO UNTIL ( Continue = TRUE )
  261.  
  262.   LOADER "BACKDROP" "XXX" "WIDTH" 4*88 "HEIGHT" NbRows*130 "COLOR" UserRed UserGreen UserBlue
  263.  
  264.   IF ( RC ~= 0 ) THEN
  265.    DO
  266.     IF ( ADPRO_RESULT = "Aborted" ) THEN
  267.      CALL ConfirmAbort
  268.     ELSE
  269.      DO
  270.       Text = MSG_UnableToCreateBackdrop || ADProResult()
  271.       OKAYN '"'TITLE_Error'"' '"'Text'"' '"'GAD_RetryAbort'"'
  272.       IF ( RC = 0 ) THEN
  273.        CALL ConfirmAbort
  274.      END
  275.    END
  276.   ELSE
  277.    Continue = TRUE
  278.  
  279.  END
  280.  
  281. /*
  282. ** Compose all selected scaled pictures files into the backdrop picture.
  283. */
  284.  
  285.  X = 0
  286.  Y = 0
  287.  
  288.  ComposedScaledPics = 0
  289.  
  290.  LOAD_TYPE "COMPOSE"
  291.  
  292.  DO Index = 1 TO NbScaledPics
  293.  
  294.   ScaledPicPath = AddPart( ScaledPicsDir, AddExt( ScaledPicsBaseName, RIGHT( Index, 3, '0' ) ) )
  295.  
  296.   Continue = FALSE
  297.   DO UNTIL ( Continue = TRUE )
  298.   
  299.    Text = MSG_LoadingScaledPic FilePart( ScaledPicPath )
  300.    DISPLAYMESSAGE '"'Text'"'
  301.  
  302.    LOADER "IFF" ScaledPicPath X+1 Y+1 100 -1 -1 -1
  303.  
  304.    IF ( RC ~= 0 ) THEN
  305.     DO
  306.      IF ( ADPRO_RESULT = "Aborted" ) THEN
  307.       CALL ConfirmAbort
  308.      ELSE
  309.       DO
  310.        Text = MSG_UnableToLoadScaledPic || DNL || ParseString( ScaledPicPath ) || ADProResult()
  311.        OKAYN '"'TITLE_Error'"' '"'Text'"' '"'GAD_RetrySkipAbort'"'
  312.        IF ( RC = 0 ) THEN
  313.         CALL ConfirmAbort
  314.        ELSE
  315.         IF ( RC = 2 ) THEN
  316.          Continue = TRUE
  317.       END
  318.     END
  319.    ELSE
  320.     DO
  321.      X = X + 88
  322.      IF ( X = 4*88 ) THEN
  323.       DO
  324.        X = 0
  325.        Y = Y + 130
  326.       END
  327.      ComposedScaledPics = ComposedScaledPics + 1
  328.      Continue = TRUE
  329.     END
  330.   END
  331.  
  332.  END
  333.  
  334.  IF ( ComposedScaledPics = 0 ) THEN
  335.   DO
  336.    OKAYN '"'TITLE_Error'"' '"'MSG_NoScaledPicLoaded'"' '"'GAD_Quit'"'
  337.    CALL Quit
  338.   END
  339.  
  340. /*
  341. ** Render backdrop picture.
  342. */
  343.  
  344.  SET_RENDER_MODE Amiga 167940 4*88 NbRows*130 HAM8
  345.  DITHER 1
  346.  
  347.  Continue = FALSE
  348.  DO UNTIL ( Continue = TRUE )
  349.  
  350.   Text = MSG_ComputingPalette
  351.   DISPLAYMESSAGE '"'Text'"'
  352.   
  353.   EXECUTE
  354.  
  355.   IF ( RC ~= 0 ) THEN
  356.    DO
  357.     IF ( ADPRO_RESULT = "Aborted" ) THEN
  358.      CALL ConfirmAbort
  359.     ELSE
  360.      DO
  361.       Text = MSG_UnableToComputePalette || ADProResult()
  362.       OKAYN '"'TITLE_Error'"' '"'Text'"' '"'GAD_RetryAbort'"'
  363.       IF ( RC = 0 ) THEN
  364.        CALL ConfirmAbort
  365.      END
  366.    END
  367.   ELSE
  368.    Continue = TRUE
  369.  
  370.  END
  371.  
  372. /*
  373. ** Modify computed palette to match Klondike specifications.
  374. */
  375.  
  376.  PPOKE 0 UserRed UserGreen UserBlue
  377.  PPOKE 1 255 0 0
  378.  PPOKE 2 255 255 255
  379.  PPOKE 3 0 0 0
  380.  PPOKE 20 255 0 0
  381.  PPOKE 24 255 0 0
  382.  
  383. /*
  384. ** Save palette file.
  385. */
  386.  
  387.  IF ( Mode = "AUTO" ) THEN
  388.   PalettePath = AddPart( ScaledPicsDir, AddExt( ScaledPicsBaseName, "Palette" ) )
  389.  ELSE
  390.  DO
  391.  
  392.  Continue = FALSE
  393.  DO UNTIL ( Continue = TRUE )
  394.  
  395.   GETFILE '"'TITLE_SelectPaletteFile'"' '"'ParseDir( ScaledPicsDir )'"' '"'AddExt( ScaledPicsBaseName, "Palette" )'"'
  396.  
  397.   IF ( RC ~= 0 ) THEN
  398.    CALL ConfirmAbort
  399.   ELSE
  400.    DO
  401.     PalettePath = ADPRO_RESULT
  402.     Continue = TRUE
  403.    END
  404.  
  405.  END
  406.  
  407.  END
  408.  
  409.  SetPref( "KADPT.PalettePath", PalettePath )
  410.  
  411.  Continue = FALSE
  412.  DO UNTIL ( Continue = TRUE )
  413.  
  414.   Text = MSG_SavingPalette
  415.   DISPLAYMESSAGE '"'Text'"'
  416.  
  417.   PSAVE PalettePath
  418.  
  419.   IF ( RC ~= 0 ) THEN
  420.    DO
  421.     IF ( ADPRO_RESULT = "Aborted" ) THEN
  422.      CALL ConfirmAbort
  423.     ELSE
  424.      DO
  425.       Text = MSG_UnableToSavePalette || DNL || ParseString( PalettePath ) || ADProResult()
  426.       ADDRESS COMMAND 'C:Delete >NIL: FILE="' || PalettePath || '" QUIET'
  427.       OKAYN '"'TITLE_Error'"' '"'Text'"' '"'GAD_RetryAbort'"'
  428.       IF ( RC = 0 ) THEN
  429.        CALL ConfirmAbort
  430.      END
  431.    END
  432.   ELSE
  433.    Continue = TRUE
  434.  
  435.  END
  436.   
  437. /*
  438. ** Quit.
  439. */
  440.  
  441. Quit:
  442.  
  443.  CLOSE_RENDER_SCREEN
  444.  CLEAR_RENDERED
  445.  CLEAR_RAW
  446.  DISPLAYMESSAGE '""'
  447.  
  448.  IF ( EXISTS( TempDefaults ) ) THEN
  449.   DO
  450.    LOAD_DEFAULTS '"'TempDefaults'"'
  451.    IF ( RC ~= 0 ) THEN
  452.     DO
  453.      Text = MSG_UnableToRestoreADProPrefs || ADProResult()
  454.      OKAY1 '"'Text'"'
  455.     END
  456.    ADDRESS COMMAND 'C:Delete >NIL: FILE="' || TempDefaults || '" QUIET'
  457.   END
  458.  
  459.  EXIT ReturnCode
  460.  
  461. RETURN
  462.  
  463. /*
  464. ** Functions.
  465. */
  466.  
  467. CheckScaledPics:
  468.  
  469.  PARSE ARG ScaledPicPath
  470.  
  471.  RetVal = "0"
  472.  
  473.  Text = MSG_CheckingScaledPic FilePart( ScaledPicPath )
  474.  DISPLAYMESSAGE '"'Text'"'
  475.     
  476.  LOAD_TYPE "REPLACE"
  477.  
  478.  Continue01 = FALSE
  479.  DO UNTIL ( Continue01 = TRUE )
  480.  
  481.   LOADER "IFF" ScaledPicPath
  482.   
  483.   IF ( RC ~= 0 ) THEN
  484.    DO
  485.     IF ( ADPRO_RESULT = "Aborted" ) THEN
  486.      CALL ConfirmAbort
  487.     ELSE
  488.      DO
  489.       Text = MSG_UnableToLoadScaledPic || DNL || ParseString( ScaledPicPath ) || ADProResult()
  490.       IF ( Mode = "AUTO" ) THEN
  491.        Gad = GAD_RetryAbort
  492.       ELSE
  493.        Gad = GAD_RetrySelectAbort
  494.       OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
  495.       IF ( RC = 0 ) THEN
  496.        CALL ConfirmAbort "NOCHECK"
  497.       ELSE
  498.        IF ( RC = 2 ) THEN
  499.         Continue01 = TRUE
  500.      END
  501.    END
  502.   ELSE
  503.    DO
  504.     XSIZE
  505.     ScaledPicWidth = ADPRO_RESULT
  506.  
  507.     YSIZE
  508.     ScaledPicHeight = ADPRO_RESULT
  509.  
  510.     IF ( ( ScaledPicWidth = 86 ) & ( ScaledPicHeight = 128 ) ) THEN
  511.      DO
  512.       ScaledPicsDir = DirPart( ScaledPicPath )
  513.       ScaledPicsBaseName = DelExt( FilePart( ScaledPicPath ) )
  514.  
  515.       Continue02 = TRUE
  516.       NbScaledPics = 0
  517.       Extension = 1
  518.  
  519.       DO UNTIL ( ( Continue02 = FALSE ) | ( NbScaledPics = 52 ) )
  520.        FileExtension = RIGHT( Extension, 3, '0' )
  521.        ScaledPicPath = AddPart( ScaledPicsDir, AddExt( ScaledPicsBaseName, FileExtension ) )
  522.        Text = MSG_CheckingScaledPic FilePart( ScaledPicPath )
  523.        DISPLAYMESSAGE '"'Text'"'
  524.        IF ( EXISTS( ScaledPicPath ) ) THEN
  525.         DO
  526.          NbScaledPics = NbScaledPics + 1
  527.          Extension = Extension + 1
  528.         END
  529.        ELSE
  530.         Continue02 = FALSE
  531.       END
  532.  
  533.       DISPLAYMESSAGE '""'
  534.        
  535.       IF ( NbScaledPics = 52 ) THEN
  536.        DO
  537.         RetVal = NbScaledPics ScaledPicsDir ScaledPicsBaseName
  538.         Continue01 = TRUE
  539.        END
  540.       ELSE
  541.        DO
  542.         Text = MSG_MissingScaledPic || DNL || ScaledPicPath
  543.         IF ( Mode = "AUTO" ) THEN
  544.          Gad = GAD_Abort
  545.         ELSE
  546.          Gad = GAD_SelectAbort
  547.         OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
  548.         IF ( RC = 0 ) THEN
  549.          CALL ConfirmAbort "NOCHECK"
  550.         Continue01 = TRUE
  551.        END
  552.      END
  553.     ELSE
  554.      DO
  555.       Text = MSG_InvalidScaledPicSize || DNL || ScaledPicPath
  556.       IF ( Mode = "AUTO" ) THEN
  557.        Gad = GAD_Abort
  558.       ELSE
  559.        Gad = GAD_SelectAbort
  560.       OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
  561.       IF ( RC = 0 ) THEN
  562.        CALL ConfirmAbort "NOCHECK"
  563.       Continue01 = TRUE
  564.      END
  565.    END
  566.  END
  567.  
  568. RETURN RetVal
  569.  
  570. /*
  571. ** Sub Routines
  572. */
  573.  
  574. ADProResult:
  575.  ADProResultText = DNL || MSG_ErrorCode RC || NL || MSG_ADProResult ADPRO_RESULT
  576. RETURN ADProResultText
  577.  
  578. ConfirmAbort:
  579.  
  580.  PARSE ARG Check
  581.  
  582.  IF ( ( Mode = "AUTO" ) & ( Check = "NOCHECK" ) ) THEN
  583.   DO
  584.    ReturnCode = 20
  585.    CALL Quit
  586.   END
  587.  ELSE
  588.   DO
  589.    OKAYN '"'TITLE_Confirm'"' '"'MSG_Abort'"' '"'GAD_ContinueAbort'"'
  590.    IF ( RC = 0 ) THEN
  591.     DO
  592.      ReturnCode = 20
  593.      CALL Quit
  594.     END
  595. RETURN
  596.  
  597. ConfirmAbort:
  598.  
  599.  PARSE ARG Check
  600.  
  601.  IF ( ( Mode = "AUTO" ) & ( Check = "NOCHECK" ) ) THEN
  602.   DO
  603.    ReturnCode = 20
  604.    CALL Quit
  605.   END
  606.  ELSE
  607.   DO
  608.    OKAYN '"'TITLE_Confirm'"' '"'MSG_Abort'"' '"'GAD_ContinueAbort'"'
  609.    IF ( RC = 0 ) THEN
  610.     DO
  611.      ReturnCode = 20
  612.      CALL Quit
  613.     END
  614. RETURN
  615.  
  616. ParseString: PROCEDURE
  617.  PARSE ARG String
  618. RETURN STRIP( String, 'B', '"' )
  619.  
  620. ParseDir: PROCEDURE
  621.  PARSE ARG Dir
  622.  Dir = ParseString( Dir )
  623.  Dir = STRIP( Dir, 'T', '/' )
  624. RETURN Dir
  625.  
  626. DirPart: PROCEDURE
  627.  PARSE ARG Path
  628.  Path = ParseString( Path )
  629.  FNameSepPos = LASTPOS( '/', Path )
  630.  IF ( FNameSepPos = 0 ) THEN
  631.   RETURN LEFT( Path, LASTPOS( ':', Path ) )
  632.  ELSE
  633.   RETURN LEFT( Path, FNameSepPos - 1 )
  634.  
  635. FilePart:
  636.  PARSE ARG Path
  637.  Path = ParseString( Path )
  638.  FNameSepPos = LASTPOS( '/', Path )
  639.  IF ( FNameSepPos = 0 ) THEN
  640.   FNameSepPos = LASTPOS( ':', Path )
  641. RETURN RIGHT( Path, LENGTH( Path ) - FNameSepPos )
  642.  
  643. AddPart:
  644.  PARSE ARG Dir, Name
  645.  LastChar = RIGHT( Dir, 1 )
  646.  IF (( LastChar ~= "/" ) & ( LastChar ~= ":" )) THEN
  647.   Dir = Dir || "/"
  648. RETURN Dir || Name
  649.  
  650. AddExt:
  651.  PARSE ARG Name, Ext
  652. RETURN Name || "." || Ext
  653.  
  654. DelExt:
  655.  PARSE ARG Name
  656.  PointPos = LASTPOS( '.', Name )
  657.  if ( PointPos ~= 0 ) THEN
  658.   Name = DELSTR( Name, PointPos )
  659. RETURN Name
  660.  
  661. GetPref: PROCEDURE
  662.  PARSE ARG Name
  663.  
  664.  Pref = GETCLIP( Name )
  665.  IF ( Pref = "" ) THEN
  666.   DO
  667.    IF ( OPEN( FileHandle, AddPart( "ENVARC:Klondike_ADPTools", Name ), "READ" ) ) THEN
  668.     DO
  669.      Pref = READLN( FileHandle )
  670.      Dummy = CLOSE( FileHandle )
  671.     END
  672.   END
  673. RETURN Pref
  674.  
  675. SetPref: PROCEDURE
  676.  PARSE ARG Name, Pref
  677.  
  678.  Dummy = SETCLIP( Name, Pref )
  679.  
  680.  IF ( ~EXISTS( "ENVARC:Klondike_ADPTools" ) ) THEN
  681.   ADDRESS COMMAND 'C:MakeDir >NIL: ENVARC:Klondike_ADPTools'
  682.   
  683.  IF ( OPEN( FileHandle, AddPart( "ENVARC:Klondike_ADPTools", Name ), "WRITE" ) ) THEN
  684.   DO
  685.    Dummy = WRITELN( FileHandle, Pref )
  686.    Dummy = CLOSE( FileHandle )
  687.   END
  688. RETURN Pref
  689.  
  690.